NOBO_GoalSetting

NOBO interactive Map: GCT & Trend Data

This document creates a leaflet map showing goals collected as part of the Northern Bobwhite, Grasslands and Savannas National Partnership along side data collected showing NOBO trends collected by James Martin

Loading Libraries

library(tidyverse)
library(sf)
library(leaflet)

## Warning: package 'leaflet' was built under R version 4.0.3

library(htmltools)

## Warning: package 'htmltools' was built under R version 4.0.5

library(htmlwidgets)
library(raster)
library(gstat)

## Warning: package 'gstat' was built under R version 4.0.3

library(spatial)
library(dplyr)
library(jsonlite)

## Warning: package 'jsonlite' was built under R version 4.0.5

library(ggplot2)
library(hrbrthemes)

## Warning: package 'hrbrthemes' was built under R version 4.0.5

library(ggthemes)
library(rgdal)

options(scipen=999)

Loading Variable Sets

##Loading Boundaries
State_Boundaries <- st_read("cb_2018_us_state_500k.kml", quiet = TRUE)
State_Boundaries_GJSON <- st_read("US_State_Boundaries.json", quiet = TRUE)
State_Boundaries_Zip <- st_read("C:/Users/sageg/Desktop/newRrepo/USDA_WLFW_NOBO/StateBoundariesZIP", quiet = T)


#loading counties
natl_priority_map<-readOGR("C:/Users/sageg/Desktop/NOBO_Boundary_Aug2021_Dissolve_ST_Draft", layer="NOBO_Boundary_Aug2021_Dissolve_ST_Draft")



##Loading GCT Data
GCT_data <- read_csv("NOBODATA_ForLeaflet_Final.csv")

##Loading RDS
bird_data <- readRDS("NOBO_route_level_trends.rds")


##Loading RDS
bird_data <- readRDS("NOBO_route_level_trends.rds")

bird_data<-as(bird_data, "Spatial")  #this converts the object, bird_data, into a SpatialPointsDataFrame






# proj4string(bird_data)<-"+proj=laea +lat_0=40 +lon_0=-95 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs"  ## if proj4string() is NA, you can define a projection.  IT HAS TO BE THE PROJECTION THAT IT WAS SUPPOSED TO HAVE ORIGINALLY

## convert the projection
bird_dat<-spTransform(bird_data, CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))

## Warning in showSRID(uprojargs, format = "PROJ", multiline = "NO"): Discarded datum WGS_1984 in CRS definition,
##  but +towgs84= values preserved

transf_natl_PA <- spTransform(natl_priority_map, CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))

## Warning in showSRID(uprojargs, format = "PROJ", multiline = "NO"): Discarded datum WGS_1984 in CRS definition,
##  but +towgs84= values preserved

Adding Geometries to GCT Data

##Joining Boundaries and GCT Data
GCT_and_Geographies <- st_as_sf(left_join(GCT_data, State_Boundaries_Zip, by =c("STATE" ="NAME")))

Creating Label for GCT Data

## Creating Label for States
GCT_and_Geographies$label <- 
  paste("<b>", "<big>", GCT_and_Geographies$STATE,"</b>", "</big>",
       "<br>", GCT_and_Geographies$REGION,
        "<br>", "Values shown below reflect the combined value of", "<br>", "Original Program Goals and Framework Goals",
       "<br>",
        "<br>",
        "<b> Top 3 Core Conservation Practices: </b>",
       "<br>",
        GCT_and_Geographies$TOP3CORE,
        "<br>",
       "<br>",
        "<b>", "Financial Assistance:", "</b>","<br>",
        "$ ", prettyNum(GCT_and_Geographies$REQFIN_FRAME,big.mark=","),
       "<br>",
        "<br>",  "<b>", "Total CP Coverage, Acres:", "</b>",
        "<br>", "Core:", prettyNum(GCT_and_Geographies$ACRE_FRAME_CORE, big.mark = ","),
        "<br>", "Supplemental:", prettyNum(GCT_and_Geographies$ACRE_FRAME_SUPP, big.mark = ","),
        "<br>", "Core and Supp Combined:", prettyNum(GCT_and_Geographies$ACRE_FRAME_CAS, big.mark = ","),
       "<br>",
        "<br>", "<b>", "Total CP Coverage, Feet:", "</b>",
        "<br>", "Core:", prettyNum(GCT_and_Geographies$FT_FRAME_CORE, big.mark = ","),
        "<br>", "Supplemental:", prettyNum(GCT_and_Geographies$FT_FRAME_SUPP, big.mark = ","),
        "<br>", "Core and Supp Combined:", GCT_and_Geographies$FT_FRAME_CAS,
       "<br>",
        "<br>", "<b>", "Total CP Coverage, Number of X:", "</b>",
        "<br>",GCT_and_Geographies$X_FRAME,
       "<br>",
        "<br>", "<b>", "Number of Written Plans:", "</b>",
        "<br>",GCT_and_Geographies$WRITTEN_FRAME,
       "<br>",
        "<br>", "<b>", "Number of Applied Plans:", "</b>",
        "<br>",GCT_and_Geographies$APPLIED_FRAME) %>% 
  lapply(htmltools::HTML)



# Creating Label for NOBO Trend Data
bird_dat$label <- 
  paste("NOBO Trend Data","<br>", "Abundance:", round(bird_dat$abund, digits=3),"<br>","Trend:", round(bird_dat$trend, digits=3),"</b>")%>%
  lapply(htmltools::HTML)

Leaflet Map in Development

# create color coded dots

bins <- seq(min(bird_dat$trend),
             max(bird_dat$trend), by = .25)
# colramp<-colorRampPalette(c("red", "yellow", "blue"))
# cols<-colramp(length(bins))

pal <- colorNumeric("magma", 
                    domain = bins,
                    na.color = "#00000000")

scale_fill_brewer(palette="RdYlGn")

## <ggproto object: Class ScaleDiscrete, Scale, gg>
##     aesthetics: fill
##     axis_order: function
##     break_info: function
##     break_positions: function
##     breaks: waiver
##     call: call
##     clone: function
##     dimension: function
##     drop: TRUE
##     expand: waiver
##     get_breaks: function
##     get_breaks_minor: function
##     get_labels: function
##     get_limits: function
##     guide: legend
##     is_discrete: function
##     is_empty: function
##     labels: waiver
##     limits: NULL
##     make_sec_title: function
##     make_title: function
##     map: function
##     map_df: function
##     n.breaks.cache: NULL
##     na.translate: TRUE
##     na.value: NA
##     name: waiver
##     palette: function
##     palette.cache: NULL
##     position: left
##     range: <ggproto object: Class RangeDiscrete, Range, gg>
##         range: NULL
##         reset: function
##         train: function
##         super:  <ggproto object: Class RangeDiscrete, Range, gg>
##     rescale: function
##     reset: function
##     scale_name: brewer
##     train: function
##     train_df: function
##     transform: function
##     transform_df: function
##     super:  <ggproto object: Class ScaleDiscrete, Scale, gg>

# setup Leaflet
leaflet(options=leafletOptions(minZoom = 4)) %>%
  addProviderTiles(providers$Stamen.Terrain) %>%
  addProviderTiles("Esri.WorldImagery", group="Aerial") %>% 
  
#create layer toggle  
  addLayersControl(
    baseGroups = c("Map", "Aerial"),
    overlayGroups = c("Points", "States", "Priority Counties"), 
    position = "topleft"
  ) %>% 
 
  #Add State Data 
  addPolygons(data=GCT_and_Geographies,
    highlightOptions = highlightOptions(fillOpacity = 1, fillColor="cornsilk"),
              weight=1, 
              fillColor= "orange",
              color = "black",
              fillOpacity=.5,
              label = paste0(GCT_and_Geographies$STATE, " - ", GCT_and_Geographies$REGION), 
              popup=~label,
              group="States",
              labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "11px",
                direction = "auto")) %>% 
  
  # Add NOBO trend Data
  addCircles(data=bird_dat, 
             color = ~pal(trend), 
            # size=bird_dat$abund,
             opacity=0.8,# fillOpacity = 0.6,
             label=paste0("Trend: 2002-2019: ", round(bird_dat$trend,digits=3)), 
             popup=~label, 
             group="Points") %>%
  
    addPolygons(data=transf_natl_PA, 
             # popup= GCT_and_Geographies$label[GCT_and_Geographies$STATE==indiana_priority_map$State],
             # color=priority$color, fillOpacity=0.8,
              #label=priority$Priority,
              color="Black",
             fillColor = "red", 
             opacity = .5,
             weight =1,
              group="Priority Counties")%>%
  
  #set Max Bounds
  setMaxBounds(lng1=-100.791110603, 
               lat1= 20,
               lng2= -66.96466,
               lat2= 71.3577635769)

## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'

## Warning in pal(trend): Some values were outside the color scale and will be
## treated as NA

## Warning in pal(trend): Some values were outside the color scale and will be
## treated as NA